home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / CLP2DLFI / WINBROWS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-10  |  9KB  |  352 lines
  1. unit Winbrows;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DBFserver, StdCtrls, VBXCtrl, Sxbrow, CommonCode;
  8.  
  9. type
  10.   TWinBrowse = class(TForm)
  11.     dbfBrowse: TSixbrowse;
  12.     Button1: TButton;
  13.     OpenDialog1: TOpenDialog;
  14.     flist: TComboBox;
  15.     Label1: TLabel;
  16.     Button2: TButton;
  17.     strlist: TComboBox;
  18.     taglist: TComboBox;
  19.     srchfor: TEdit;
  20.     infld: TComboBox;
  21.     Label3: TLabel;
  22.     Label4: TLabel;
  23.     recnum: TLabel;
  24.     oftot: TLabel;
  25.     Button3: TButton;
  26.     procedure Button1Click(Sender: TObject);
  27.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure flistClick(Sender: TObject);
  30.     procedure taglistClick(Sender: TObject);
  31.     procedure Button2Click(Sender: TObject);
  32.     procedure infldClick(Sender: TObject);
  33.     procedure srchforKeyPress(Sender: TObject; var Key: Char);
  34.     procedure dbfBrowseKeyUp(Sender: TObject; var Key: Word;
  35.       Shift: TShiftState);
  36.     procedure dbfBrowseEditWhen(Sender: TObject; var nCol: Integer;
  37.       var cField: TBasicString; var lCancel: Integer);
  38.     procedure Button3Click(Sender: TObject);
  39.   private
  40.     { Private declarations }
  41.     fstruct:DBFstruct;
  42.         CanModify:boolean;
  43.     alist:array [1..MaxDBFs] of string[15];
  44.     acnt:integer;
  45.     TagDat:TagInfo;
  46.     BrowseName:string[20];
  47.     BrowseAlias:oDB;
  48.         procedure FillBrowse(UseDBF:string);
  49.         procedure DoSearch;
  50.   public
  51.     { Public declarations }
  52.         procedure OpenNow(ByAlias:string);
  53.   end;
  54.  
  55. var
  56.   WinBrowse: TWinBrowse;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. procedure TWinBrowse.Button1Click(Sender: TObject);
  63. begin
  64.   Close;
  65. end;
  66.  
  67. procedure TWinBrowse.FillBrowse(UseDBF:string);
  68. var ii,jj:integer;
  69.     tt:string;
  70. begin
  71.     if Gen.CantView(CoreFile(UseDBF)) then begin
  72.     OKBox('Access Denied: '+upper(usedbf));
  73.     exit;
  74.   end;
  75.   if not Gen.CanBrowse then begin
  76.         if not Gen.ModifyOK(CoreFile(UseDBF)) then begin
  77.       OKBox('Not Available, See ''Status'' For List Of Valid Files');
  78.       exit
  79.     end;
  80.   end;
  81.   if not dbIsClosed(BrowseAlias) then dbClose(BrowseAlias);
  82.   if not dbuse(BrowseAlias,UseDBF) then exit;
  83.   Caption:='Browse: '+upper(CoreFile(UseDBF));
  84.   dbfbrowse.dbf:=BrowseAlias.Area;
  85.   dbfbrowse.ntx:=1;
  86.   BrowseAlias.GetDBFstruct(fstruct);
  87.   taglist.enabled:=true;
  88.   strlist.enabled:=true;
  89.   srchfor.enabled:=true;
  90.   infld.enabled:=true;
  91.   strlist.clear;
  92.   strlist.items.add('DataBase Structure');
  93.   with fstruct do begin
  94.       for ii:=1 to fcount do begin
  95.       tt:=padr(fname[ii],13)+' '+ftype[ii]+' '+transform(fwidth[ii],'999');
  96.       if fdecs[ii]>0 then begin
  97.         tt:=tt+', '+ltrim(transform(fdecs[ii],'999'));
  98.       end;
  99.       strlist.items.add(tt);
  100.     end;
  101.   end;
  102.   strlist.itemindex:=0;
  103.   BrowseAlias.gotop;
  104.   with fstruct, dbfBrowse do begin
  105.     Cols:=fcount;
  106.     autobrowse:=true;
  107.     tt:='';
  108.     infld.clear;
  109.     infld.items.add('Use Index');
  110.         CanModify:=Gen.CanBrowseModify;
  111.         if not CanModify then begin
  112.             if Gen.ModifyOK(CoreFile(UseDBF)) then CanModify:=true;
  113.         end;
  114.     for ii:=0 to fcount-1 do begin
  115.       jj:=length(fname[ii+1]);
  116.       if fwidth[ii+1]>jj then jj:=fwidth[ii+1];
  117.       if jj>255 then jj:=255;
  118.       ColWidth[ii]:=jj;
  119.       ColField[ii]:=fname[ii+1];
  120.       if (jj+length(tt))<255 then begin
  121.         tt:=tt+padr(fname[ii+1],jj);
  122.         infld.items.add('In '+fname[ii+1]);
  123.       end;
  124.     end;
  125.     infld.itemindex:=0;
  126.     LoadTags(BrowseAlias,TagDat);
  127.     taglist.clear;
  128.     if TagDat.TagCnt>0 then begin
  129.       for ii:=1 to TagDat.tagcnt do taglist.items.add('By '+TagDat.keys[ii]);
  130.       taglist.itemindex:=0;
  131.     end;
  132.     taglist.items.add('Natural Order');
  133.     row:=1;
  134.     col:=1;
  135.     header:=tt;
  136.     ii:=row;  { leave these in so that row,col can be accessed from debugger }
  137.     ii:=col;
  138.     recnum.caption:='Row '+inttostr(row);
  139.       oftot.caption:='Of '+inttostr(BrowseAlias.reccount);
  140.     end;
  141.   dbfbrowse.action:=2;
  142.   srchfor.setfocus;
  143. end;
  144.  
  145. procedure TWinBrowse.FormClose(Sender: TObject; var Action: TCloseAction);
  146. begin
  147.   fstruct.free;
  148.   TagDat.free;
  149.   if not dbIsClosed(BrowseAlias) then dbClose(BrowseAlias);
  150.   Gen.ReleaseWin(self);
  151.   action:=caFree;
  152. end;
  153.  
  154. procedure TWinBrowse.FormCreate(Sender: TObject);
  155. var ii,jj:integer;
  156.     tt:string;
  157. begin
  158.   fstruct:=DBFstruct.Create;
  159.   TagDat:=TagInfo.Create;
  160.   BrowseAlias:=Nil;
  161.   top:=0;
  162.   left:=0;
  163.   width:=605;
  164.   height:=374;
  165.     centerhoriz(self);
  166.   Gen.AddWin('Browse',self);
  167.   jj:=0;
  168.   acnt:=0;
  169.   for ii:=1 to 120 do begin
  170.     DoEvents2;
  171.     tt:=dbSelectArea(ii);
  172.     if not empty(tt) then begin
  173.       pp(acnt);
  174.       alist[acnt]:=tt;
  175.     end else begin
  176.       pp(jj); { exit after finding 10 empty areas }
  177.       if jj>10 then break;
  178.     end;
  179.   end;
  180.   if acnt>0 then begin
  181.     flist.clear;
  182.     flist.items.add(' Currently Open');
  183.     for ii:=1 to acnt do begin
  184.       flist.items.add(alist[ii]);
  185.     end;
  186.     flist.itemindex:=0;
  187.   end;
  188.   infld.clear;
  189.   srchfor.text:='';
  190.   taglist.enabled:=false;
  191.   strlist.enabled:=false;
  192.   srchfor.enabled:=false;
  193.   infld.enabled:=false;
  194.   BrowseName:='Browse '+inttostr(Gen.MiscWinCnt+1);
  195. end;
  196.  
  197. procedure TWinBrowse.OpenNow(ByAlias:string);
  198. var ii,jj:integer;
  199. begin
  200.   ByAlias:=upper(ByAlias);
  201.   if acnt>0 then begin
  202.     jj:=0;
  203.     for ii:=1 to acnt do begin
  204.       if ByAlias=alist[ii] then begin
  205.         jj:=ii;
  206.         break;
  207.       end;
  208.     end;
  209.     if jj>0 then begin
  210.       flist.itemindex:=jj;
  211.       FillBrowse(DBFname[jj]);
  212.     end;
  213.   end;
  214. end;
  215.  
  216. procedure TWinBrowse.flistClick(Sender: TObject);
  217. var ii,jj:integer;
  218. begin
  219.   if flist.itemindex>0 then begin
  220.     jj:=0;
  221.     for ii:=1 to acnt do begin
  222.       if flist.items[flist.itemindex]=alist[ii] then begin
  223.         jj:=ii;
  224.         break;
  225.       end;
  226.     end;
  227.     if jj>0 then FillBrowse(DBFname[jj]);
  228.   end;
  229.   srchfor.setfocus;
  230. end;
  231.  
  232. procedure TWinBrowse.taglistClick(Sender: TObject);
  233. begin
  234.   if taglist.itemindex=(taglist.items.count-1) then begin
  235.       dbfbrowse.ntx:=0;  { by record number }
  236.     button3.caption:='&Go To Row';
  237.   end else begin
  238.       dbfbrowse.ntx:=taglist.itemindex+1;
  239.     button3.caption:='&Search For';
  240.   end;
  241.   dbfbrowse.action:=2;
  242.   srchfor.setfocus;
  243. end;
  244.  
  245. procedure TWinBrowse.Button2Click(Sender: TObject);
  246. var tt:string;
  247.     ii:integer;
  248. begin
  249.   with opendialog1 do begin
  250.     initialdir:='\ACCTING\JCDAT';
  251.     if pin('ACCTTEST',upper(gen.rootdir)) then
  252.         initialdir:='\ACCTTEST\JCDAT';
  253.     execute;
  254.     tt:=opendialog1.filename;
  255.   end;
  256.   if fileexists(tt) then begin
  257.     ii:=pos('.',tt);
  258.     if ii>1 then tt:=copy(tt,1,ii-1);
  259.     FillBrowse(tt);
  260.   end;
  261. end;
  262.  
  263. procedure TWinBrowse.infldClick(Sender: TObject);
  264. begin
  265.   dbfbrowse.setfocus;
  266. end;
  267.  
  268. procedure TWinBrowse.DoSearch;
  269. var ii:integer;
  270.     tdate:longint;
  271.     tt,tt2,tdbl:string;
  272. begin
  273.   if infld.itemindex=0 then begin
  274.     if srchfor.text='TOP' then BrowseAlias.gotop
  275.     else if pos('BOT',srchfor.text)=1 then BrowseAlias.gobottom else
  276.     begin
  277.       if taglist.itemindex<taglist.items.count-1 then
  278.           BrowseAlias.seek(srchfor.text) else
  279.       begin
  280.         tdate:=strtoint(transform(procdbl(srchfor.text),'999999'));
  281.         if (tdate>0) and (tdate<=BrowseAlias.lastrec) then begin
  282.           BrowseAlias.go(tdate);
  283.         end;
  284.       end;
  285.     end;
  286.   end else begin
  287.     ii:=infld.itemindex;
  288.     with fstruct do begin
  289.       tt:=srchfor.text;
  290.       MouseWait;
  291.       if ftype[ii]='C' then begin
  292.         if (pin(tt,upper(BrowseAlias.s(fname[ii])))) and
  293.           (not BrowseAlias.eof)
  294.           then BrowseAlias.skip;
  295.         while not BrowseAlias.eof do begin
  296.           if pin(tt,upper(BrowseAlias.s(fname[ii]))) then break;
  297.           BrowseAlias.skip;
  298.         end;
  299.       end;
  300.       if ftype[ii]='N' then begin
  301.         tdbl:=ltrim(transform(procdbl(tt),'999999999.9999'));
  302.         tt2:=transform(BrowseAlias.f(fname[ii]),'999999999.9999');
  303.         if (pin(tt,tt2)) and (not BrowseAlias.eof) then BrowseAlias.skip;
  304.         while not BrowseAlias.eof do begin
  305.           tt2:=transform(BrowseAlias.f(fname[ii]),'999999999.9999');
  306.           if pin(tt,tt2) then break;
  307.           BrowseAlias.skip;
  308.         end;
  309.       end;
  310.       if ftype[ii]='D' then begin
  311.         tdate:=ctod(tt);
  312.         if (tdate=BrowseAlias.d(fname[ii])) and
  313.           (not BrowseAlias.eof) then BrowseAlias.skip;
  314.         while not BrowseAlias.eof do begin
  315.           if tdate=BrowseAlias.d(fname[ii]) then break;
  316.           BrowseAlias.skip
  317.         end;
  318.       end;
  319.       MouseGo;
  320.     end;
  321.   end;
  322.   dbfbrowse.action:=2;
  323.   dbfbrowse.setfocus;
  324. end;
  325.  
  326. procedure TWinBrowse.srchforKeyPress(Sender: TObject; var Key: Char);
  327. begin
  328.   if getret(key) then begin
  329.     DoSearch;
  330.   end;
  331. end;
  332.  
  333. procedure TWinBrowse.dbfBrowseKeyUp(Sender: TObject; var Key: Word;
  334.   Shift: TShiftState);
  335. begin
  336.   recnum.caption:='Row '+inttostr(BrowseAlias.recno);
  337.   oftot.caption:='Of '+inttostr(BrowseAlias.reccount);
  338. end;
  339.  
  340. procedure TWinBrowse.dbfBrowseEditWhen(Sender: TObject; var nCol: Integer;
  341.   var cField: TBasicString; var lCancel: Integer);
  342. begin
  343.   if not CanModify then lCancel:=-1;
  344. end;
  345.  
  346. procedure TWinBrowse.Button3Click(Sender: TObject);
  347. begin
  348.   if not empty(srchfor.text) then DoSearch;
  349. end;
  350.  
  351. end.
  352.